home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 7: Sunsite / Linux Cubed Series 7 - Sunsite Vol 1.iso / system / shells / scsh-0.4 / scsh-0 / scsh-0.4.2 / rts / jar-defrecord.scm < prev    next >
Text File  |  1995-10-13  |  2KB  |  48 lines
  1. ; Copyright (c) 1993, 1994 Richard Kelsey and Jonathan Rees.  See file COPYING.
  2.  
  3.  
  4. ; This is JAR's define-record-type, which doesn't resemble Richard's.
  5.  
  6. ; There's no implicit name concatenation, so it can be defined
  7. ; entirely using syntax-rules.  Example:
  8. ;  (define-record-type foo :foo
  9. ;    (make-foo x y)
  10. ;    foo?              - predicate name is optional
  11. ;    (x foo-x)
  12. ;    (y foo-y)
  13. ;    (z foo-z set-foo-z!))
  14.  
  15. (define-syntax define-record-type
  16.   (syntax-rules ()
  17.     ((define-record-type ?id ?type
  18.        (?constructor ?arg ...)
  19.        (?field . ?field-stuff)
  20.        ...)
  21.      (begin (define ?type (make-record-type '?id '(?field ...)))
  22.         (define ?constructor (record-constructor ?type '(?arg ...)))
  23.         (define-accessors ?type (?field . ?field-stuff) ...)))
  24.     ((define-record-type ?id ?type
  25.        (?constructor ?arg ...)
  26.        ?pred
  27.        ?more ...)
  28.      (begin (define-record-type ?id ?type
  29.           (?constructor ?arg ...)
  30.           ?more ...)
  31.         (define ?pred (record-predicate ?type))))))
  32.  
  33. ; Straightforward version
  34. (define-syntax define-accessors
  35.   (syntax-rules ()
  36.     ((define-accessors ?type ?field-spec ...)
  37.      (begin (define-accessor ?type . ?field-spec) ...))))
  38.  
  39. (define-syntax define-accessor
  40.   (syntax-rules ()
  41.     ((define-accessor ?type ?field ?accessor)
  42.      (define ?accessor (record-accessor ?type '?field)))
  43.     ((define-accessor ?type ?field ?accessor ?modifier)
  44.      (begin (define ?accessor (record-accessor ?type '?field))
  45.         (define ?modifier (record-modifier ?type '?field))))
  46.     ((define-accessor ?type ?field)
  47.      (begin))))
  48.